home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / plymrpht / frmabout.frm (.txt) < prev    next >
Visual Basic Form  |  1998-05-27  |  10KB  |  241 lines

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About PolyMorph"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    Icon            =   "frmAbout.frx":0000
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   237
  15.    ScaleMode       =   3  'Pixel
  16.    ScaleWidth      =   382
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   2  'CenterScreen
  19.    Begin VB.CommandButton cmdOK 
  20.       Cancel          =   -1  'True
  21.       Caption         =   "OK"
  22.       Default         =   -1  'True
  23.       Height          =   345
  24.       Left            =   4245
  25.       TabIndex        =   0
  26.       Top             =   2625
  27.       Width           =   1260
  28.    End
  29.    Begin VB.CommandButton cmdSysInfo 
  30.       Caption         =   "&System Info..."
  31.       Height          =   345
  32.       Left            =   4260
  33.       TabIndex        =   1
  34.       Top             =   3075
  35.       Width           =   1245
  36.    End
  37.    Begin VB.Label Label1 
  38.       Caption         =   "http://www.global.co.za/~tmi"
  39.       BeginProperty Font 
  40.          Name            =   "MS Sans Serif"
  41.          Size            =   9.75
  42.          Charset         =   0
  43.          Weight          =   700
  44.          Underline       =   0   'False
  45.          Italic          =   0   'False
  46.          Strikethrough   =   0   'False
  47.       EndProperty
  48.       Height          =   315
  49.       Left            =   1785
  50.       TabIndex        =   6
  51.       Top             =   2070
  52.       Width           =   3870
  53.    End
  54.    Begin VB.Image Image2 
  55.       Height          =   540
  56.       Left            =   465
  57.       Picture         =   "frmAbout.frx":030A
  58.       Stretch         =   -1  'True
  59.       Top             =   525
  60.       Width           =   750
  61.    End
  62.    Begin VB.Image Image1 
  63.       BorderStyle     =   1  'Fixed Single
  64.       Height          =   1290
  65.       Left            =   45
  66.       Picture         =   "frmAbout.frx":0858
  67.       Stretch         =   -1  'True
  68.       Top             =   135
  69.       Width           =   1575
  70.    End
  71.    Begin VB.Line Line1 
  72.       BorderColor     =   &H00808080&
  73.       BorderStyle     =   6  'Inside Solid
  74.       Index           =   1
  75.       X1              =   6
  76.       X2              =   376.933
  77.       Y1              =   163
  78.       Y2              =   163
  79.    End
  80.    Begin VB.Label lblDescription 
  81.       Caption         =   $"frmAbout.frx":31D2
  82.       ForeColor       =   &H00000000&
  83.       Height          =   840
  84.       Left            =   1725
  85.       TabIndex        =   2
  86.       Top             =   1110
  87.       Width           =   3885
  88.    End
  89.    Begin VB.Label lblTitle 
  90.       Caption         =   "PolyMorph Data Entry Control"
  91.       BeginProperty Font 
  92.          Name            =   "MS Sans Serif"
  93.          Size            =   12
  94.          Charset         =   0
  95.          Weight          =   700
  96.          Underline       =   0   'False
  97.          Italic          =   0   'False
  98.          Strikethrough   =   0   'False
  99.       EndProperty
  100.       ForeColor       =   &H00000000&
  101.       Height          =   480
  102.       Left            =   1725
  103.       TabIndex        =   4
  104.       Top             =   225
  105.       Width           =   3885
  106.    End
  107.    Begin VB.Line Line1 
  108.       BorderColor     =   &H00FFFFFF&
  109.       BorderWidth     =   2
  110.       Index           =   0
  111.       X1              =   7
  112.       X2              =   376.933
  113.       Y1              =   164
  114.       Y2              =   164
  115.    End
  116.    Begin VB.Label lblVersion 
  117.       Caption         =   "Version 1.0"
  118.       Height          =   225
  119.       Left            =   1725
  120.       TabIndex        =   5
  121.       Top             =   765
  122.       Width           =   3885
  123.    End
  124.    Begin VB.Label lblDisclaimer 
  125.       Caption         =   $"frmAbout.frx":3273
  126.       ForeColor       =   &H00000000&
  127.       Height          =   825
  128.       Left            =   255
  129.       TabIndex        =   3
  130.       Top             =   2625
  131.       Width           =   3870
  132.    End
  133. Attribute VB_Name = "frmAbout"
  134. Attribute VB_GlobalNameSpace = False
  135. Attribute VB_Creatable = False
  136. Attribute VB_PredeclaredId = True
  137. Attribute VB_Exposed = False
  138. Option Explicit
  139. ' Reg Key Security Options...
  140. Const READ_CONTROL = &H20000
  141. Const KEY_QUERY_VALUE = &H1
  142. Const KEY_SET_VALUE = &H2
  143. Const KEY_CREATE_SUB_KEY = &H4
  144. Const KEY_ENUMERATE_SUB_KEYS = &H8
  145. Const KEY_NOTIFY = &H10
  146. Const KEY_CREATE_LINK = &H20
  147. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  148.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  149.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  150.                      
  151. ' Reg Key ROOT Types...
  152. Const HKEY_LOCAL_MACHINE = &H80000002
  153. Const ERROR_SUCCESS = 0
  154. Const REG_SZ = 1                         ' Unicode nul terminated string
  155. Const REG_DWORD = 4                      ' 32-bit number
  156. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  157. Const gREGVALSYSINFOLOC = "MSINFO"
  158. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  159. Const gREGVALSYSINFO = "PATH"
  160. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  161. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  162. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  163. Private Sub cmdSysInfo_Click()
  164.   Call StartSysInfo
  165. End Sub
  166. Private Sub cmdOK_Click()
  167.   Unload Me
  168. End Sub
  169. Public Sub StartSysInfo()
  170.     On Error GoTo SysInfoErr
  171.     Dim rc As Long
  172.     Dim SysInfoPath As String
  173.     ' Try To Get System Info Program Path\Name From Registry...
  174.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  175.     ' Try To Get System Info Program Path Only From Registry...
  176.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  177.         ' Validate Existance Of Known 32 Bit File Version
  178.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  179.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  180.             
  181.         ' Error - File Can Not Be Found...
  182.         Else
  183.             GoTo SysInfoErr
  184.         End If
  185.     ' Error - Registry Entry Can Not Be Found...
  186.     Else
  187.         GoTo SysInfoErr
  188.     End If
  189.     Call Shell(SysInfoPath, vbNormalFocus)
  190.     Exit Sub
  191. SysInfoErr:
  192.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  193. End Sub
  194. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  195.     Dim i As Long                                           ' Loop Counter
  196.     Dim rc As Long                                          ' Return Code
  197.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  198.     Dim hDepth As Long                                      '
  199.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  200.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  201.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  202.     '------------------------------------------------------------
  203.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  204.     '------------------------------------------------------------
  205.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  206.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  207.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  208.     KeyValSize = 1024                                       ' Mark Variable Size
  209.     '------------------------------------------------------------
  210.     ' Retrieve Registry Key Value...
  211.     '------------------------------------------------------------
  212.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  213.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  214.